perm filename F4.F4[NEW,LCS]3 blob
sn#513485 filedate 1980-05-20 generic text, type T, neo UTF8
C***** OUTLIM(I,J), UPDN(NST), NOIR(DUMMY), NOTAIL(X), POSIT(V), SLEND
C***** JUSTXT
C K←15↔J←14↔ M←2↔ R2←5↔ X←6↔ L←4↔ R←7↔ A←11↔RY←3↔RZ←13↔JJ2←12
C OUTLIM: 0 ; FUNCTION OUTLIM(I,J)
C SETO 0, ; OUTLIM=-1
C MOVE 1,@(16) ; IF(RN(I+J).LT.R4)RETURN
C ADD 1,@1(16)
C MOVE 1,XRN-1(1) ;ALL AC1 WERE AC2 25/10/79********
C CAMGE 1,.COMM.+5
C JRA 16,2(16) ; IF(RN(I+J).GT.R5)RETURN
C CAMG 1,.COMM.+6
C SETZ 0, ; OUTLIM=0
C JRA 16,2(16)
FUNCTION OUTLIM(I,J)
COMMON R2,JA,CENTR,J2,R3,R4,R5 /XRN/RN(1)
OUTLIM=-1
R=RN(I+J)
IF(R.LT.R4)RETURN
IF(R.GT.R5)RETURN
OUTLIM=0
END
SUBROUTINE UPDN(NST)
INTEGER PWDS
COMMON/XRN/RN(1) /KJY/ DONT,JY /POSI/S(8),JJ2,P
COMMON R2,JA,CENTR,J2,RJQ(18),RX6,JR,L
1/PTR/PWDS(1) /LIMIT/LIMIT,ITEM
EQUIVALENCE (R4,RJQ(2)),(R5,RJQ(3)),(R11,RJQ(9))
1,(R6,RJQ(4))
DO 1 K=NST,ITEM
L=PWDS(K)
IF(RTLINE(L))GO TO 1
RY=RN(L+1)
IF(RY.GT.16)GO TO 1
IF(RY.EQ.8)GO TO 1
IF(RY.EQ.3)GO TO 1
IF(RY.EQ.R6)GO TO 10
IF(R6.NE.0)GO TO 1
C DIDN'T MATCH THE CODE NUM.
10 IF(RY.NE.4)GO TO 11
IF(RN(L).LT.3)GO TO 1
C A BAR LINE
11 IF(OUTLIM(L,3))GO TO 2
RN(L+4)=RN(L+4)+R11
IF(K.LT.JJ2)JJ2=K
2 IF(RY.LT.4)GO TO 1
IF(RY.GE.7)GO TO 1
C NO WIGGLE ON TRILL
RNL=RN(L+5)
IF(RY.NE.4.)GO TO 12
IF(RNL.EQ.50.OR.RNL.EQ.150)GO TO 1
C CRESC. OR BOX
12 IF(OUTLIM(L,6))GO TO 1
RN(L+5)=RNL+R11
IF(JJ2)JJ2=K
IF(K.LT.JJ2)JJ2=K
1 CONTINUE
END
C UPDN: 0 ;SUBROUTINE UPDN(NST)
C ;INTEGER PWDS
C ;COMMON/XRN/RN(4000) /KJY/ DONT,JY /POSI/S(8),JJ2,P
C ;COMMON R2,JA,CENTR,J2,RJQ(18),RX6,JR,L,RDIS,VY,JQ(17)
C ;1/PTR/PWDS(250),ITEM,LL,I,IX
C MOVE 7,@(16) ;EQUIVALENCE (R4,RJQ(2)),(R5,RJQ(3)),(R11,RJQ(9))
C SOJ 7, ;1,(R6,RJQ(4))
C MOVE 15,LIMIT+1 ; AC7 IS K-1
C ;; MOVE 15,PTR+=250 ; AC7 IS K-1
C SOJ 15, ;(ITEM-1)
C UPDN0: JSA 16,RTLINE ;DO 1 K=NST,ITEM
C JUMP PTR(7) ;L=PWDS(K)
C JUMPL UPDN1 ; IF(RTLINE(L))GO TO 1
C MOVE 11,PTR(7) ;RY=RN(L+1) -- 11 IS L
C MOVE 12,XRN(11) ;IF(RY.GT.16)GO TO 1
C CAMG 12,[16.0] ; AC12=RY
C CAME 12,[8.0] ;IF(RY.EQ.8)GO TO 1
C CAMN 12,[3.0] ;IF(RY.EQ.3)GO TO 1
C JRST UPDN1
C CAMN 12,.COMM.+7 ;IF(RY.EQ.R6)GO TO 10
C JRST UPDN10
C SKIPE .COMM.+7 ;IF(R6.NE.0)GO TO 1
C JRST UPDN1
C UPDN10: CAME 12,[4.0] ; DIDN'T MATCH THE CODE NUM.
C JRST UPDN11 ;10 ;IF(RY.NE.4)GO TO 11
C MOVE 2,XRN-1(11) ;IF(RN(L).LT.3)GO TO 1
C CAMGE 2,[3.0]
C JRST UPDN1 ; A BAR LINE
C UPDN11: JSA 16,OUTLIM ;11 IF(OUTLIM(L,3))GO TO 2
C JUMP PTR(7)
C JUMP [3]
C JUMPL UPDN2
C MOVE 2,.COMM.+=12 ;RN(L+4)=RN(L+4)+R11
C FADRM 2,XRN+3(11)
C ;IF(JJ2)JJ2=K
C MOVE 0,7
C AOJ
C CAMGE POSI+=8
C MOVEM POSI+=8 ;IF(K.LT.JJ2)JJ2=K
C UPDN2: CAML 12,[4.0] ;2 ;IF(RY.LT.4)GO TO 1
C CAML 12,[7.0] ;IF(RY.GE.7)GO TO 1
C JRST UPDN1 ; NO WIGGLE ON TRILL
C CAME 12,[4.0] ;IF(RY.NE.4.)GO TO 12
C JRST UPDN12
C MOVE XRN+4(11) ;IF(RN(L+5).EQ.50.OR. - - .EQ.150)GO TO 1
C CAME [50.0] ;AC0 IS RN(L+5)
C CAMN [150.0]
C JRST UPDN1 ; CRESC. OR BOX
C UPDN12: JSA 16,OUTLIM ;12 ;IF(OUTLIM(L,6))GO TO 1
C JUMP PTR(7)
C JUMP [6]
C JUMPL UPDN1
C MOVE 3,.COMM.+=12 ;RN(L+5)=RN(L+5)+R11
C FADRM 3,XRN+4(11)
C MOVE 0,7 ;IF(JJ2)JJ2=K
C AOJ
C CAMGE POSI+=8
C MOVEM POSI+=8 ;IF(K.LT.JJ2)JJ2=K
C UPDN1: CAMGE 7,15 ;1 ;CONTINUE
C AOJA 7,UPDN0
C JRA 16,1(16) ;END
SUBROUTINE NOIR
END
FUNCTION NOTAIL(X)
NOTAIL=0
Z=ABS(X)
IF(Z.LT..56.OR.Z.EQ..75)RETURN
IF(Z.EQ..875.OR.Z.EQ..6)RETURN
NOTAIL=-1
END
FUNCTION POSIT(V)
COMMON/RINP/R(10,85),POSNT(0/99)
IF(V)V=-V
C REREAD OR SOMETHING MAKES /1 C- 2/ GIVE A -2 FOR LAST NUM.!!!???
K=V
A=POSNT(K)
POSIT=A+(POSNT(K+1)-A)*AMOD(V,1.0)
C TYPE /2.3 -- FOR POSITION BETWEEN NTS 2 AND 3. ETC.
END
C SLEND: 0 ; SUBROUTINE SLEND
SUBROUTINE SLEND
C MOVE 8,[8.0] ;INTEGER PWDS
INTEGER PWDS
C MOVE 7,SCM+=80 ;C TO FIND END POINTS OF STAVES
CC COMMON/XRN/RN(1) /KJY/ DONT,JY /POSI/S(8),JJ2,P
CC COMMON R2,JA,CENTR,J2,RJQ(18),RX6,JR,L
CC 1/PTR/PWDS(1) /LIMIT/LIMIT,ITEM
COMMON/XRN/RN(1) /SCM/V(78),I,LCNT,STAFF,LIST(200),REND
1 /PTR/PWDS(1) /LIMIT/LIMIT,ITEM /RMOD/RMODE2,RSET4,IBEAM,
1 NOSET,STEM,STUP,NTC,ENDP,RAD,RDD,ITB,POSB
C MOVE 4,[4.0];COMMON/XRN/RN(2000),IT,POS,RA,NN,JB,RB,A,B,JMP,JK,C,
C SETZ 5, ;DO 1 K=1,ITEM
DO 1 K=1,ITEM
L=PWDS(K)
C SLN1: MOVE 6,PTR(5) ;L=PWDS(K)
IF(RN(L+1).NE.8)GO TO 1
C FOUND A STAFF
IF(RN(L+2).NE.STAFF)GO TO 1
C CAMN 8,XRN(6) ;C FOUND A STAFF ;IF(RN(L+2).NE.STAFF)GO TO 1
C CAME 7,XRN+1(6) ;C GOT THE RIGHT ONE
IF(ITB.LT.0)GO TO 2
C JRST SLN1X ;IF(IT)GO TO 2
POSB=202
C SKIPGE RMOD+=10 ;POS=202
C JRST SLN2 ;C NOW CHECK LEFT SIDE OF STAFF
IF(RN(L).LT.4)RETURN
C MOVSI 15,210624 ;[202.0] ;IF(RN(L).LT.4)RETURN
C CAML 4,XRN-1(6) ;P6 WASN'T MENTIONED - SO IT =200
C JRST SLN3
POSB=RN(L+6)+2
IF(POSB.EQ.2)POSB=202
C MOVE 15,XRN+5(6) ;IF(POS.EQ.2)POS=202
RETURN
C FADR 15,[2.0] ;RETURN
2 POSB=RN(L+3)-2.3
C CAMN 15,[2.0] ;2 POS=RN(L+3)-2.3
RETURN
C MOVSI 15,210624 ;[202.0] ;RETURN
1 CONTINUE
C JRST SLN3 ;1 CONTINUE
END
C SLN2: MOVE 15,XRN+2(6) ;END
C FSBR 15,[2.3]
C SLN3: MOVEM 15,RMOD+=11
C JRA 16,(16)
C SLN1X: AOS 5
C CAMGE 5,LIMIT+1
C JRST SLN1
C SKIPLE RMOD+=11 ;IF(POS.LE.0)RETURN
C JRST SLN2-2 ;POS=202 (IN CASE THERE IS NO STAFF)
C JRA 16,(16) ;END
SUBROUTINE JUSTXT(R2,R4,R5)
COMMON/RINP/RNO(2,250),NO(350),NP(250)
C ARRAY NO(X) USED IN 'MOVIT'. HOLDS ALL POINTS TO BE MOVED AT ANY TIME.
COMMON /STF/RSTFAC(0/7),RSTJ2 /XRN/RN(1)
COMMON R0,JA,CENTR,J2,RJQ(18),RX6,JR,L,RDIS,VY,JQ(17)
1 /POSI/STFF(0/7),JJ2,POS /LIMIT/LIMIT,ITEM,LL,I,IX/PTR/KWDS(1)
2 /ALF/INP(46),ACCX,ML,RRT,RZRO,NCNT,JSZ,OV,RSPC,KN,RA,RB,
3 JLDGR,LDGR,JX,RW,RX,RY,RZ,JJ,RD,RQ,RE,RZZ,RN3,RN6,R44,R55
EQUIVALENCE (R6,RJQ(4)),(R7,RJQ(5))
1,(R3,RJQ(1)),(R8,RJQ(6)),(R9,RJQ(7)),(I2,INP(2))
DATA RDX/1.5/
R0=11
C R0 IS REALLY R2
CALL GETPTS(1)
C GO SETUP NO ARRAY FOR MOVIT
R44=R4
R55=R5
RD=RDX*RSTJ2
C RD IS IDEAL MINIMUM BETWEED CHAR. STRINGS
6 RE=9999.
KN=0
R9=0
R8=0
RZZ=0
DO 1 K=1,ITEM
J=KWDS(K)
R=RN(J+1)
IF(R.NE.16.)GO TO 1
IF(RN(J+2).NE.R2)GO TO 1
C ASSUMES P9 HAS SPACE INFO
JJ=KWDS(K+1)
IF(RN(JJ+1).NE.16.)GO TO 2
IF(RN(JJ).GT.7.)GO TO 1
C JUMP IF FOUND CONTINUING CHARS. (P10=1)
2 RA=RN(J+3)
IF(RA.LT.R4.OR.RA.GT.R5)GO TO 1
C NOW FIND NEXT WORD.
RX=9999.
33 DO 3 JX=1,ITEM
JR=KWDS(JX)
R=RN(JR+1)
IF(R.NE.16.)GO TO 3
IF(RN(JR+2).NE.R2)GO TO 3
RZ=RN(JR+3)
IF(RZ.LE.RA)GO TO 3
IF(RZ.GT.R5)GO TO 3
IF(RZ.GE.RX)GO TO 3
RX=RZ
3 CONTINUE
IF(RX.EQ.9999.)GO TO 1
C NOW WE HAVE NEXT WD.
RW=RA+RN(J+9)*RN(J+5)*RSTJ2
C RW = POS. OF 1ST CHAR + WIDTH OF CHAR. STRING
RQ=RX-RW-RD
IF(RQ.GE.0)GO TO 1
CC RZZ=RZZ-RQ*1.5
RQ=RQ*1.5
R5=R5-RQ
C RZZ=AMOUNT TO MOVE
R8=-RQ
KN=-1
4 CALL MOVIT(RN,NO,RX,RE,R8,R9)
1 CONTINUE
R9=200
R8=0
R4=0
5 CALL MOVIT(RN,NO,R4,R5,R8,R9)
IF(KN.EQ.0)RETURN
RD=RD-.5
R4=R44
R5=R55
GO TO 6
END